perm filename INDAT4.SAI[C,ALS] blob
sn#130768 filedate 1974-11-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY PREPARE
C00005 00003 INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH)
C00008 00004 PROCEDURE FORMANT
C00014 00005 INTERNAL PROCEDURE PREPARE
C00015 ENDMK
C⊗;
ENTRY PREPARE;
BEGIN
DEFINE ⊂="COMMENT",CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
DEFINE ⊃="⊂"; ⊂ Used to delete output statements for PLOT;
DEFINE $="⊂"; ⊂ Used to delete outstr's;
DEFINE Z="10000%256";
EXTERNAL REAL ARRAY A,C,D[0:512];
⊃ INTERNAL INTEGER ARRAY NEW[0:512];
INTERNAL INTEGER ARRAY INNAME,INDATA[0:32];
EXTERNAL INTEGER ARRAY FVAL[0:8];
INTEGER I,J,K,P,POINTP,NX;
⊃ EXTERNAL INTEGER CHAN5;
INTERNAL INTEGER INFLAG;
INTEGER F1_LOW,F1_HI,F2_LOW,F2_HI,F3_LOW,F3_HI,F4_LOW,F4_HI,F5_LOW;
INTEGER F5_HI,NP_LOW,NP_HI,NZ_LOW,NZ_HI,FP1_LO,FP1_H,FP2_LO,FP2_H;
INTERNAL INTEGER F1,F2,F3,F4,F5,NP,NZ,FP1,FP2,A1,A2,A3,A4,A5;
INTEGER FA,FB,FC,FD,FE;
INTEGER M1,M2,M3,M4,M5;
INTERNAL PROCEDURE DEFINES;
BEGIN
F1_LOW← 180 * 256%10000; F1_HI← 850 * 256%10000;
F2_LOW← 700 * 256%10000; F2_HI← 2500 * 256%10000;
F3_LOW← 1570 * 256%10000; F3_HI← 3400 * 256%10000;
F4_LOW← 2500 * 256%10000; F4_HI← 4500 * 256%10000;
F5_LOW← 3600 * 256%10000; F5_HI← 5400 * 256%10000;
M1← 320 * 256%10000;
M2← 1350 * 256%10000;
M3← 2800 * 256%10000;
M4← 3400 * 256%10000;
M5← 4500 * 256%10000;
FP1_LO← 1800 * 256%10000; FP1_H← 3200 * 256%10000;
FP2_LO← 3200 * 256%10000; FP2_H← 5000 * 256%10000;
NP_LOW← 800 * 256%10000; NP_HI← 1500 * 256%10000;
NZ_LOW←NP-500* 256%10000; NZ_HI←NP+500* 256%10000;
END;
INTERNAL PROCEDURE DATOUT;
BEGIN
⊃ ARRYOUT(CHAN5,NEW[0],512);
⊃ POINTP←POINT(9,NEW[1],-1);
NX←0;
END;
INTEGER PROCEDURE PEAK (INTEGER LOW,HIGH);
BEGIN
INTEGER I,J,K; REAL MAX,MIN;
MAX←-10000; K←LOW;
FOR I←LOW STEP 1 UNTIL HIGH DO
IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
IF J=LOW THEN BEGIN
MAX←-10000; MIN←10000;
FOR I←LOW STEP 1 UNTIL HIGH DO BEGIN
IF C[I]>MIN THEN DONE;
IF C[I]<MIN THEN BEGIN MIN←C[I]; K←I; END;
END;
FOR I←K STEP 1 UNTIL HIGH DO
IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
END;
IF J=HIGH THEN BEGIN
MAX←-10000; MIN←10000;
FOR I←HIGH STEP -1 UNTIL K DO BEGIN
IF C[I]>MIN THEN DONE;
IF C[I]<MIN THEN MIN←C[I];
END;
FOR I←I STEP -1 UNTIL K DO
IF C[I]>MAX THEN BEGIN MAX←C[I]; J←I; END;
END;
IF J=LOW THEN J←0; ⊂ No proper peak found;
RETURN(J);
END;
INTEGER PROCEDURE BAND(INTEGER F);
BEGIN
INTEGER I,J;
FOR I←F STEP 1 UNTIL 255 DO IF (C[I]+6)≤C[F] THEN DONE;
⊂ OUTSTR("F="&CVS(F)&TB&"I="&CVS(I)&TB);
FOR J←F STEP -1 UNTIL 0 DO IF (C[J]+6)≤C[F] THEN DONE;
⊂ OUTSTR("J="&CVS(J)&CRLF);
IF (F-J)<(I-F) THEN RETURN(F-J) ELSE RETURN(I-F);
END;
INTEGER PROCEDURE REMOVE(INTEGER F,LIMIT);
BEGIN
INTEGER I,J,K;
REAL X,Y,MAX,MIN;
FOR I←F STEP 1 UNTIL LIMIT DO IF C[I]≤C[F]-6 THEN BEGIN J←I; DONE; END;
FOR I←F STEP -1 UNTIL 0 DO IF C[I]≤C[F]-6 THEN BEGIN K←I; DONE; END;
IF ABS(F-K)<ABS(J-F) THEN I←ABS(F-K) ELSE I←ABS(J-F);
X←6.0; X←X/(I*I);
MAX←-10000;
⊂ OUTSTR("I="&CVS(I)&" ");
FOR I←I+F STEP 1 UNTIL LIMIT DO
IF (Y←(C[I]-C[F]+X*(I-F)*(I-F)))>MAX THEN BEGIN MAX←Y; J←I; END;
IF J=LIMIT THEN J←0;
RETURN(J);
END;
PROCEDURE FORMANT;
BEGIN
REAL X,Y;
IF INFLAG=0 THEN BEGIN
⊃ POINTP←POINT(9,NEW[1],-1); NX←0;
INNAME[P]←CVASC("F1"); P←P+1;
INNAME[P]←CVASC("F2"); P←P+1;
INNAME[P]←CVASC("F3"); P←P+1;
INNAME[P]←CVASC("F4"); P←P+1;
INNAME[P]←CVASC("F5"); P←P+1;
INNAME[P]←CVASC("A1"); P←P+1;
INNAME[P]←CVASC("A2"); P←P+1;
INNAME[P]←CVASC("A3"); P←P+1;
INNAME[P]←CVASC("A4"); P←P+1;
INNAME[P]←CVASC("A5"); P←P+1;
INNAME[P]←CVASC("B1"); P←P+1;
INNAME[P]←CVASC("B2"); P←P+1;
INNAME[P]←CVASC("B3"); P←P+1;
INNAME[P]←CVASC("B4"); P←P+1;
INNAME[P]←CVASC("B5"); P←P+1;
END ELSE BEGIN
$ OUTSTR(CRLF&"⊗ ");
FA←PEAK(0,M1);
F1←PEAK(F1_LOW,F1_HI);
F2←PEAK(F2_LOW,F2_HI);
IF (C[FA]>C[F1])∧(F1=F2) THEN BEGIN
FB←REMOVE(FA,F1); $ OUTSTR("Voice bar,");
IF C[FB]>C[F1] THEN BEGIN
$ OUTSTR("Remove,old F1="&CVS(F1*Z)&",New="&CVS(FA*Z)&TB);
F1←FA; END;
END;
IF (F1+3>INDATA[P])∧(F1+4<F2_LOW) THEN F2←PEAK(F2_LOW,F2_HI)
ELSE BEGIN
IF INDATA[P]>F2_LOW THEN F2←PEAK(INDATA[P]+1,F2_HI)
ELSE F2←PEAK(F2_LOW,F2_HI); END;
F3←PEAK(F3_LOW,F3_HI);
F4←PEAK(F4_LOW,F4_HI);
F5←PEAK(F5_LOW,F5_HI);
IF F1=F2 THEN BEGIN
$ OUTSTR("F1=F2="&CVS(F1*10000%256));
FA←PEAK(F1_LOW,F1);
IF FA=0 THEN X←0 ELSE X←C[FA];
FB←PEAK(F2,F2_HI);
IF FB=0 THEN Y←0 ELSE Y←C[FB];
IF (X>Y)∧((X+6)>C[F1]) THEN F1←FA ELSE F2←FB;
$ OUTSTR("FA="&CVS(FA*Z)&","&CVF(X)&"FB="&CVS(FB*Z)&","&CVF(Y)&TB);
END;
IF F2=0 THEN BEGIN
F2←REMOVE(F1,F2_HI);
$ OUTSTR("REMOVE ");
END;
IF F2<F2_LOW THEN F2←INDATA[P+1];
IF (F2+4) < F3_LOW THEN F3←PEAK(F3_LOW-2,F3_HI)
ELSE F3←PEAK(F3_LOW,F3_HI);
IF F2=F3 THEN BEGIN
$ OUTSTR("F2=F3="&CVS(F3*10000%256));
FC←PEAK(F3,F3_HI);
IF FC=0 THEN Y←0 ELSE Y←C[FC];
IF F1>F2_LOW THEN FB←PEAK(F1,F3) ELSE FB←PEAK(F2_LOW,F3);
IF FB=0 THEN X←0 ELSE X←C[FB];
IF (Y+6>X)∧((Y+24)>C[F3]) THEN F3←FC ELSE F2←FB;
$ OUTSTR("FB="&CVS(FB*Z)&","&CVS(X)&"FC="&CVS(FC*Z)&","&CVF(Y)&TB);
END;
IF ((C[F2]+24)<C[F1])∧(F1>F2_LOW) THEN BEGIN
IF F3>F2_HI THEN FB←REMOVE(F1,F2) ELSE FB←REMOVE(F1,F2_HI);
IF FB←0 THEN X←0 ELSE X←C[FB];
IF X>C[F2] THEN F2←FB;
END;
IF F3=F4 THEN BEGIN
$ OUTSTR("F3=F4="&CVS(F4*10000%256));
FD←PEAK(F4,F4_HI);
IF FD=0 THEN Y←0 ELSE Y←C[FD];
IF F2>F3_LOW THEN FC←PEAK(F2,F4) ELSE FC←PEAK(F3_LOW,F4);
IF FC=0 THEN X←0 ELSE X←C[FC];
IF Y+12≥X THEN F4←FD ELSE F3←FC;
$ OUTSTR("FC="&CVS(FC*Z)&","&CVS(X)&"FD="&CVS(FD*Z)&","&CVF(Y)&TB);
END;
IF F4=F5 THEN BEGIN
$ OUTSTR("F4=F5="&CVS(F5*10000%256));
FE←PEAK(F5,F5_HI);
IF FE=0 THEN Y←0 ELSE Y←C[FE];
IF F3>F4_LOW THEN FD←PEAK(F3,F5) ELSE FD←PEAK(F4_LOW,F5);
IF FD=0 THEN X←0 ELSE X←C[FD];
IF Y+12≥X THEN F5←FE ELSE F4←FD;
$ OUTSTR("FD="&CVS(FD*Z)&","&CVS(X)&"FE="&CVS(FE*Z)&","&CVF(Y)&TB);
END;
$ OUTSTR(CRLF&TB&CVS(F1*Z)&","&CVS(F2*Z)&","&CVS(F3*Z)&","&CVS(F4*Z)
&","&CVS(F5*Z)&TB&CVF(C[F1])&","&CVF(C[F2])&","&CVF(C[F3])&","&
CVF(C[F4])&","&CVS(C[F5])&CRLF);
INDATA[P]←F1; P←P+1;
INDATA[P]←F2; P←P+1;
INDATA[P]←F3; P←P+1;
INDATA[P]←F4; P←P+1;
INDATA[P]←F5; P←P+1;
INDATA[P]←C[F1]; P←P+1;
INDATA[P]←C[F2]; P←P+1;
INDATA[P]←C[F3]; P←P+1;
INDATA[P]←C[F4]; P←P+1;
INDATA[P]←C[F5]; P←P+1;
INDATA[P]←BAND(F1)*10000%256; P←P+1;
INDATA[P]←BAND(F2)*10000%256; P←P+1;
INDATA[P]←BAND(F3)*10000%256; P←P+1;
INDATA[P]←BAND(F4)*10000%256; P←P+1;
INDATA[P]←BAND(F5)*10000%256; P←P+1;
END;
END;
INTERNAL PROCEDURE PREPARE;
BEGIN
P←0;
FORMANT;
⊃ IF INFLAG≠0 THEN BEGIN
⊃ NEW[NX]←FVAL[4];
⊃ FOR I←0 STEP 1 UNTIL 27 DO IDPB(INDATA[I],POINTP);
⊃ FOR I←1 STEP 1 UNTIL 4 DO IBP(POINTP);
⊃ NX←NX+8;
⊃ IF NX≥512 THEN DATOUT;
⊃ END;
END;
END;